home *** CD-ROM | disk | FTP | other *** search
/ Aminet 23 / Aminet 23 (1998)(GTI - Schatztruhe)[!][Feb 1998].iso / Aminet / dev / lang / nrcobol_1b.lha / NRCOBOL1b / COBFILES / INADS3.COB < prev    next >
Text File  |  1997-06-25  |  11KB  |  311 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID.   INADS3.
  3.       *PROGRAM DISCRIPTION.
  4.       *
  5.       *program to create data for index files paper.nam and advert.typ
  6.       *
  7.       *AUTHOR.        cHArRiOTt.
  8.       *INSTALLATION.
  9.       *DATE-WRITTEN.  24th AUG 89.
  10.       *DATE-COMPILLED.
  11.       *SECURITY.
  12.        ENVIRONMENT DIVISION.
  13.  
  14.        CONFIGURATION SECTION.
  15.        SOURCE-COMPUTER.   AMSTRAD 1512.
  16.        OBJECT-COMPUTER.
  17.        INPUT-OUTPUT SECTION. 
  18.        FILE-CONTROL.
  19.  
  20.             SELECT           IN-NEWSPAPER-NAME
  21.             ASSIGN TO        DISK
  22.             ORGANIZATION IS  INDEXED
  23.             ACCESS MODE  IS  SEQUENTIAL
  24.             RECORD KEY IS  ER-PAPER-CODE
  25.             FILE STATUS  IS  WS-PAPER-FILE-STATUS.
  26.  
  27.             SELECT           IN-ADVERT-TYPE
  28.             ASSIGN TO        DISK
  29.             ORGANIZATION IS  INDEXED
  30.             ACCESS MODE  IS  SEQUENTIAL
  31.             RECORD KEY IS  ER-IN-AD-CODE
  32.             FILE STATUS  IS  WS-AD-TYPE-STATUS.
  33.  
  34.       *
  35.        DATA DIVISION.
  36.        FILE SECTION.
  37.        FD IN-NEWSPAPER-NAME
  38.             LABEL RECORD IS  STANDARD
  39.             VALUE OF FILE-ID IS "PAPER.NAM".
  40.        01 ER-NEWSPAPER-NAME.
  41.            03 ER-PAPER-CODE         PIC X(3).
  42.            03 ER-PAPER-NAME         PIC X(25).
  43.       *
  44.        FD IN-ADVERT-TYPE
  45.             LABEL RECORD IS  STANDARD
  46.             VALUE OF FILE-ID IS "ADVERT.TYP".
  47.        01 ER-ADVERT-TYPE.
  48.            03 ER-IN-AD-CODE         PIC 9(3).
  49.            03 ER-TYPE-OF-AD         PIC X(20).
  50.            03 ER-PRICE-PER-LINE     PIC 9V99.
  51.       *
  52.       **********************************************************
  53.       *
  54.        WORKING-STORAGE SECTION.
  55.        01 WS-NEWSPAPER-NAME.
  56.            03 WS-PAPER-CODE         PIC X(3).
  57.               88 WS-TERMINATE-PAPER VALUE "999".
  58.            03 WS-PAPER-NAME         PIC X(25).
  59.       *
  60.        01 WS-ADVERT-TYPE.
  61.            03 WS-IN-AD-CODE         PIC 9(3).
  62.               88 WS-TEMINATE-ADVERTS VALUE 999.
  63.            03 WS-TYPE-OF-AD         PIC X(20).
  64.            03 WS-PRICE-PER-LINE     PIC 9V99.
  65.       *
  66.        01 WS-REAL-DATE.
  67.            03 WS-REAL-YEAR          PIC XX.
  68.            03 WS-REAL-MONTH         PIC XX.
  69.            03 WS-REAL-DAY           PIC XX.
  70.        01 WS-TEMP-DATE.
  71.            03 WS-TEMP-DAY           PIC XX.
  72.            03 FILLER                PIC X  VALUE "/".
  73.            03 WS-TEMP-MONTH         PIC XX.
  74.            03 FILLER                PIC X  VALUE "/".
  75.            03 WS-TEMP-YEAR          PIC XX.
  76.       *
  77.        01 WS-COUNTERS.
  78.            03 WS-PAGE-COUNTER           PIC 99.
  79.            03 WS-LINE-COUNTER           PIC 99.
  80.            03 ws-file-counter           pic 999 value 0.
  81.            03 WS-PAPER-KEY              PIC 999.
  82.            03 WS-ADVERT-KEY             PIC 999.
  83.  
  84.        01 WS-INVALID-KEY            PIC X   VALUE " ".
  85.        01 WS-END-ENTRY              PIC X   VALUE " ".
  86.        01 WS-STOP-RUN-FLAG          PIC X   VALUE " ".
  87.        01 WS-END-FILE-FLAG          PIC X   VALUE " ".
  88.        01 WS-ABORT-READ-FLAG        PIC X   VALUE " ".
  89.        01 WS-PAPER-FILE-STATUS      PIC XX  VALUE "00".
  90.        01 WS-AD-TYPE-STATUS         PIC XX  VALUE "00".
  91.        01 WS-RESPONCE               PIC X.
  92.            88  WS-RESPONCE-Q        VALUE  "Q" "q".
  93.            88  WS-RESPONCE-A        VALUE  "A" "a".
  94.            88  WS-RESPONCE-P        VALUE  "P" "p".
  95.            88  WS-RESPONCE-YN       VALUE  "Y" "N"
  96.                                            "y" "n".
  97.            88  WS-RESPONCE-Y        VALUE  "Y" "y".
  98.            88  WS-RESPONCE-N        VALUE  "N" "n".
  99.       *
  100.       **********************************************************
  101.       *
  102.        SCREEN SECTION.
  103.        01 BLANK-SCREEN.
  104.            03 BLANK SCREEN.
  105.        01 PROG-DISCRIPTION.
  106.            03 LINE 1 COLUMN 5      VALUE 
  107.            "A PROGRAM TO PRODUCE DATA FOR CLASSIFIED ADVERTISING INCOME 
  108.       -    " REPORT".
  109.        01 DIS-PROG-TITLE.
  110.            03 LINE 3 COLUMN 1   PIC X(8) FROM WS-TEMP-DATE.
  111.            03 LINE 3 COLUMN 22     HIGHLIGHT VALUE
  112.                                "DATA FOR ADVERTISING INCOME REPORT".
  113.            03 LINE 3 COLUMN 65     VALUE "PAGE ".
  114.            03 LINE 3 COLUMN 70  PIC X(8) FROM WS-PAGE-COUNTER.
  115.        01 PAPER-REC.
  116.            03 LINE 6  COLUMN 5  VALUE     
  117.                    "NEWSPAPER DATABASE,   Please enter as directed".
  118.            03 LINE 10 COLUMN 5  VALUE  "NEWSPAPER NAME : ".
  119.            03 LINE 10 COLUMN 22 PIC X(25) USING WS-PAPER-NAME.
  120.            03 LINE 12 column 5  value  "NEWSPAPER CODE : ".
  121.            03 LINE 12 COLUMN 22 PIC X(3)  USING WS-PAPER-CODE.
  122.            03 LINE 18 COLUMN 5  VALUE  "NEWSPAPER CODE '999' TO EXIT".
  123.        01 ADVERTS-REC.
  124.            03 LINE 6  COLUMN 5  VALUE     
  125.                    "ADVERTS DATABASE      Please enter as directed".
  126.            03 LINE 10 COLUMN 5  VALUE  "ADVERT CODE (numeric)  : ".
  127.            03 LINE 10 COLUMN 30 PIC 9(3)  USING WS-IN-AD-CODE.
  128.            03 LINE 12 COLUMN 5  VALUE  "TYPE OF ADVERT (20 MAX): ".
  129.            03 LINE 12 COLUMN 30 PIC X(20) USING WS-TYPE-OF-AD.
  130.            03 LINE 14 COLUMN 5  VALUE  "COST OF ADVERT (9.99)  : ".
  131.            03 LINE 14 COLUMN 30 PIC 9V99  USING WS-PRICE-PER-LINE.
  132.            03 LINE 18 COLUMN 5  VALUE  "ADVERT CODE '999' TO EXIT".
  133.        01 BAD-KEY.
  134.            03 LINE 18 COLUMN 5  VALUE "BAD KEY FIELD PLEASE TRY AGAIN".
  135.  
  136.        01 MENU.
  137.            03 LINE 8  COLUMN 33    UNDERLINE  VALUE "MENU".
  138.            03 LINE 13 COLUMN 22 VALUE "PRESS 'A' to create ADVERT.TYP".
  139.            03 LINE 15 COLUMN 22 VALUE "      'P' to create PAPER.NAME".
  140.            03 LINE 17 COLUMN 22 VALUE "      'Q' to quit     MENU   ".
  141.            03 LINE 20 COLUMN 19 VALUE "NOW WHAT? ".
  142.        01 MENU-INPUT.
  143.            03 LINE 20 COLUMN 29    PIC X TO WS-RESPONCE AUTO.
  144.        01 TASK-RUNING.
  145.            03 LINE 23 COLUMN 5     HIGHLIGHT VALUE 
  146.                                             "REPORT NOW BEING PRINTED". 
  147.        01 PROG-FINISH.
  148.            03 LINE 25 COLUMN 1     BLANK LINE.
  149.            03 LINE 25 COLUMN 5     VALUE "TASK COMPLEATE".
  150.        01 ANY-KEY.
  151.            03 LINE 25 COLUMN 33    PIC X TO WS-RESPONCE AUTO.
  152.        01 RESPONCE-LINE.
  153.            03 LINE 25 COLUMN 5     VALUE 
  154.               "PRINT ANY KEY TO CONTINUE > ".
  155.       * 
  156.        01 ERROR-MESSAGES.
  157.            03 LINE 23 COLUMN 5  VALUE 
  158.                      "FILE WOULD NOT OPEN :ADS:PAP:TYP:PRT:".
  159.            03 LINE 24 COLUMN 5  VALUE 
  160.                      "STATUS ERROR CODES  :   :   :   :   :".
  161.            03 LINE 24 COLUMN 30  HIGHLIGHT  PIC XX
  162.               FROM WS-PAPER-FILE-STATUS.
  163.            03 LINE 24 COLUMN 34  HIGHLIGHT  PIC XX
  164.               FROM WS-AD-TYPE-STATUS.           
  165.       *
  166.       **********************************************************
  167.       *
  168.        PROCEDURE DIVISION.
  169.       *
  170.        0000-MAIN.
  171.            OPEN INPUT  IN-NEWSPAPER-NAME.
  172.            OPEN INPUT  IN-ADVERT-TYPE.
  173.                 IF WS-PAPER-FILE-STATUS = "00"  AND
  174.                    WS-AD-TYPE-STATUS    = "00"
  175.                          PERFORM 1000-DISPLAY 
  176.                                  UNTIL WS-STOP-RUN-FLAG = "S"
  177.                    ELSE
  178.                          DISPLAY ERROR-MESSAGES.
  179.            CLOSE IN-NEWSPAPER-NAME.
  180.            CLOSE IN-ADVERT-TYPE.
  181.            STOP RUN.
  182.       *
  183.       **********************************************************
  184.       *
  185.        1000-DISPLAY.
  186.            ACCEPT WS-REAL-DATE FROM DATE.
  187.            MOVE WS-REAL-DAY   TO WS-TEMP-DAY.
  188.            MOVE WS-REAL-MONTH TO WS-TEMP-MONTH.
  189.            MOVE WS-REAL-YEAR  TO WS-TEMP-YEAR.
  190.            MOVE 1 TO WS-PAGE-COUNTER.
  191.            MOVE SPACE TO WS-END-ENTRY.
  192.            PERFORM 1005-NEWSCREEN.
  193.  
  194.            DISPLAY MENU.
  195.            ACCEPT  MENU-INPUT.
  196.            IF WS-RESPONCE-Q
  197.                  MOVE "S" TO WS-STOP-RUN-FLAG
  198.                  DISPLAY PROG-FINISH
  199.              ELSE
  200.              IF WS-RESPONCE-A
  201.                    MOVE 33 TO ER-IN-AD-CODE
  202.                    START IN-ADVERT-TYPE 
  203.                          KEY IS > ER-IN-AD-CODE
  204.                          INVALID KEY DISPLAY BAD-KEY
  205.                          ACCEPT  ANY-KEY
  206.                    END-START
  207.       
  208.                    PERFORM 1100-ADVERTS-REC
  209.                                 UNTIL WS-END-ENTRY = "S"
  210.                ELSE
  211.                IF WS-RESPONCE-P
  212.       *               MOVE 3 TO WS-PAPER-KEY
  213.       *               START IN-NEWSPAPER-NAME 
  214.       *                     KEY = WS-PAPER-KEY
  215.       *                     INVALID KEY DISPLAY BAD-KEY
  216.       *               END-START
  217.                      PERFORM 1200-PAPER-REC   
  218.                                   UNTIL WS-END-ENTRY = "S".
  219.       *
  220.        1005-NEWSCREEN.
  221.            DISPLAY BLANK-SCREEN.
  222.            DISPLAY PROG-DISCRIPTION.
  223.            DISPLAY DIS-PROG-TITLE. 
  224.  
  225.       *
  226.       **********************************************************
  227.       *
  228.        1102-ADVERTS-REC.
  229.  
  230.            READ IN-ADVERT-TYPE INTO WS-ADVERT-TYPE
  231.               AT END MOVE "S" TO WS-END-ENTRY.
  232.            IF NOT WS-END-ENTRY = "S"
  233.               PERFORM 1005-NEWSCREEN
  234.               DISPLAY ADVERTS-REC
  235.               DISPLAY RESPONCE-LINE
  236.               ACCEPT  ANY-KEY.
  237.       *
  238.       **********************************************************
  239.       *
  240.        1100-ADVERTS-REC. 
  241.            PERFORM 1005-NEWSCREEN.
  242.            PERFORM 1105-BLANK-ADVERTS.
  243.            MOVE " " TO WS-INVALID-KEY.
  244.            DISPLAY ADVERTS-REC.
  245.       *     ACCEPT  ADVERTS-REC.
  246.            IF NOT WS-TEMINATE-ADVERTS
  247.       *        MOVE WS-IN-AD-CODE TO WS-ADVERT-KEY
  248.               READ IN-ADVERT-TYPE INTO WS-ADVERT-TYPE
  249.                    AT END MOVE "E" TO WS-INVALID-KEY
  250.               END-READ
  251.               IF NOT WS-INVALID-KEY = " "
  252.                  MOVE "S" TO WS-END-ENTRY
  253.               ELSE
  254.                  DISPLAY ADVERTS-REC
  255.                  DISPLAY RESPONCE-LINE
  256.                  ACCEPT  ANY-KEY
  257.               END-IF    
  258.            ELSE
  259.               MOVE "S" TO WS-END-ENTRY.
  260.             
  261.       *
  262.        1105-BLANK-ADVERTS.
  263.            MOVE SPACES TO WS-TYPE-OF-AD.
  264.            MOVE ZERO   TO WS-IN-AD-CODE.
  265.            MOVE ZERO   TO WS-PRICE-PER-LINE. 
  266.       *
  267.       **********************************************************
  268.       *
  269.        1202-PAPER-REC.
  270.            READ IN-NEWSPAPER-NAME INTO WS-NEWSPAPER-NAME
  271.                 AT END MOVE "S" TO WS-END-ENTRY.
  272.            IF NOT WS-END-ENTRY = "S"
  273.               PERFORM 1005-NEWSCREEN
  274.               DISPLAY PAPER-REC
  275.               DISPLAY RESPONCE-LINE
  276.               ACCEPT  ANY-KEY.
  277.       *
  278.       **********************************************************
  279.       *
  280.       
  281.        1200-PAPER-REC. 
  282.            PERFORM 1005-NEWSCREEN.
  283.            PERFORM 1205-BLANK-PAPER.
  284.            MOVE " " TO WS-INVALID-KEY.
  285.            DISPLAY PAPER-REC.
  286.       *     ACCEPT  PAPER-REC.
  287.            IF NOT WS-TERMINATE-PAPER
  288.       *        MOVE WS-PAPER-CODE TO WS-PAPER-KEY
  289.               READ IN-NEWSPAPER-NAME INTO WS-NEWSPAPER-NAME
  290.                    AT END MOVE "E" TO WS-INVALID-KEY
  291.               END-READ
  292.               IF NOT WS-INVALID-KEY = " "
  293.                  MOVE "S" TO WS-END-ENTRY
  294.               ELSE
  295.                  DISPLAY PAPER-REC
  296.                  DISPLAY RESPONCE-LINE
  297.                  ACCEPT  ANY-KEY
  298.               END-IF
  299.            ELSE
  300.               MOVE "S" TO WS-END-ENTRY.
  301.       *
  302.        1205-BLANK-PAPER.
  303.            MOVE SPACES TO WS-NEWSPAPER-NAME.
  304.       *     move ws-file-counter to WS-PAPER-CODE.
  305.       *
  306.       **********************************************************
  307.       
  308.  
  309.  
  310.  
  311.